home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / BIMAIL.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  10KB  |  317 lines
  1. UNIT BiMail;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ BiModem Mail Interface                        Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos;
  16.  
  17. PROCEDURE AddToTransferList(CONST FileName: STRING; InventName: BOOLEAN);
  18. PROCEDURE WriteBiModemConfig(port: BYTE; Speed: WORD; CONST Path: PathStr);
  19. PROCEDURE BiMailPostParse;
  20.  
  21. IMPLEMENTATION
  22.  
  23. USES OpString, OpCrt, OpDate,
  24.      Globals, PoPTypes, FileUtil, MailUtil, StrUtil, Com, LogFile, NetFile, SimpDB,
  25.      Util;
  26.  
  27. PROCEDURE AddToTransferList(CONST FileName: STRING; InventName: BOOLEAN);
  28. VAR
  29.   f : FILE OF TBiModemTransfer;
  30.   b : TBiModemTransfer;
  31.   s : STRING;
  32. BEGIN
  33.   ASSIGN(f,MakeTaskFileName('BIMODEM.PTH')); FileMode:=ShareRW+ShareDenyW;
  34.   RESET(f);
  35.   IF IORESULT<>0 THEN REWRITE(f) ELSE SEEK(f,FILESIZE(f));
  36.   FILLCHAR(b,SIZEOF(b),32);
  37.   Move(filename[1],b.source,Length(filename));
  38.   IF InventName THEN
  39.   BEGIN
  40.     s:=InventPktName;
  41.     Move(s[1],b.destination,length(s));
  42.     Pause(6);
  43.   END;
  44.   b.direction:='U';
  45.   WRITE(f,b);
  46.   CLOSE(f);
  47. END;
  48.  
  49. PROCEDURE WriteBiModemConfig(port:BYTE; Speed:WORD; CONST Path: PathStr);
  50. VAR
  51.   f : FILE OF TBiModemCfg;
  52.   c : TBiModemCfg;
  53.   s : String;
  54. BEGIN
  55.   ASSIGN(f,MakeTaskFileName(PoPBimodemCfgFileName)); FileMode:=ShareRead+ShareDenyNone;
  56.   RESET(f);
  57.   IF IOResult<>0 THEN
  58.   BEGIN
  59.     ASSIGN(f,PoPBimodemCfgFileName); FileMode:=ShareRead+ShareDenyNone;
  60.     RESET(f);
  61.   END;
  62.   IF IOResult=0 THEN
  63.   BEGIN
  64.     READ(f,c);
  65.     Close(f);
  66.   END ELSE
  67.     FillChar(c,SizeOf(c),0);
  68.   c.MaxSize:=0; c.MaxTimeHour:=23; c.baudrate:=Speed;
  69.   c.comport:=port;
  70.   FillChar(c.defaultpathfile,SizeOf(c.defaultpathfile),32);
  71.  
  72.   s:=MakeTaskFileName(Path+'bimodem.pth');
  73.   Move(s[1],c.DefaultPathFile,Length(s));
  74.  
  75.   MkDir(Copy(Cfg.inbound[GlobNodeStat],1,Length(Cfg.Inbound[GlobNodeStat])-1)+'.ABT');
  76.   IF IOResult=0 THEN ;
  77.   s:=Copy(Cfg.inbound[GlobNodeStat],1,Length(Cfg.Inbound[GlobNodeStat])-1)+'.ABT\';
  78.   Move(s[1],c.AbortPath,Length(s));
  79.  
  80.   FillChar(c.defaultreceive,SizeOf(c.defaultreceive),32);
  81.   Move(cfg.inbound[GlobNodeStat][1],c.defaultreceive,Length(Cfg.Inbound[GlobNodeStat]));
  82.  
  83.   FillChar(c.RejectListPath,SizeOf(c.RejectListPath),' ');
  84.   c.BitMap1:=c.BitMap1 Or 144;
  85.   c.BitMap2:=c.BitMap2 Or 70;
  86.   c.UseCarrier:='Y';
  87.   c.WaitForConnect:=60;
  88.   c.CurDirAccess:='N'; c.RemoteFReq:='Y'; c.LocalFreq:='Y';
  89.   c.MaxErrPrFile:=0;
  90.   c.SkipIfSameDate:='Y';
  91.   Assign(f,MakeTaskFileName(PoPBimodemCfgFileName));
  92.   ReWrite(f); WRITE(f,c);CLOSE(f);
  93. END;
  94.  
  95. PROCEDURE BiMailPostParse;
  96. TYPE
  97.   TabType=ARRAY[1..200] OF String;
  98. VAR
  99.   l : LongInt;
  100.   IsMail,IsReq : Boolean;
  101.   sr : SearchRec;
  102.   s,filename : String;
  103.   bf : FILE OF TBimodemInterComm;
  104.   b : TBiModemInterComm;
  105.   i,FileNum : Integer;
  106.   FileTab   : ^TabType;
  107.   IftF : PTitFile;
  108.   Ift  : TInboundFile;
  109.   Ext  : S3;
  110.  
  111.   PROCEDURE AddToList(CONST FNam: STRING);
  112.   BEGIN
  113.     INC(FileNum);
  114.     FileTab^[FileNum]:=StUpCase(FNam);
  115.   END;
  116.  
  117.   FUNCTION FindFile(CONST FNam: STRING): BOOLEAN;
  118.   VAR
  119.     b:BOOLEAN;
  120.     i:INTEGER;
  121.   BEGIN
  122.     b:=FALSE;
  123.     IF FileNum>0 THEN
  124.     BEGIN
  125.       i:=0;
  126.       REPEAT
  127.         INC(i);
  128.         IF StUpCase(Fnam)=FileTab^[i] THEN b:=TRUE;
  129.       UNTIL (i=FileNum) OR b;
  130.     END;
  131.     FindFile:=b;
  132.   END;
  133.  
  134.   PROCEDURE KillFLOfile(CONST ExtFlags : S5);
  135.   LABEL
  136.     next;
  137.   VAR
  138.     FName, HoldName : PathStr;
  139.     c, AkaNum      : Byte;
  140.     fp             : FILE;
  141.     s, SPtr        : String;
  142.     Current, LastStart : LongInt;
  143.     i              : Char;
  144.     SkippedOne, NoMoreAkas : Boolean;
  145.     Ch : Char;
  146.     OldAdr:TFidoAddress;
  147.   BEGIN
  148.     NoMoreAkas:=False; AkaNum:=0;
  149.     OldAdr:=Call;
  150.     REPEAT
  151.       HoldName:=HoldAreaPath(Call,False);
  152.       FOR c:=1 TO 5 DO
  153.       BEGIN
  154.         SkippedOne:=False;
  155.         FName:=HoldFileName(Call,False)+ExtFlags[c]+'LO';
  156.         Assign(fp, FName); FileMode:=ShareRW+ShareDenyW;
  157.         Reset(fp,1);
  158.         IF IoResult=0 THEN
  159.         BEGIN
  160.           Current:=0;
  161.           WHILE NOT EOF(fp) DO
  162.           BEGIN
  163.             LastStart:=Current;
  164.             ReadLine(fp,s);
  165.             SPtr:=s;
  166.             Current:=FilePos(fp);
  167.             IF SPtr[1]=TruncAfter THEN
  168.             BEGIN
  169.               SPtr:=Copy(SPtr, 2, Length(SPtr)-1);
  170.               i:=TruncAfter;
  171.             END ELSE
  172.               IF SPtr[1]=ShowDeleteAfter THEN
  173.               BEGIN
  174.                 SPtr:=Copy(SPtr, 2, Length(SPtr)-1);
  175.                 i:=ShowDeleteAfter;
  176.               END ELSE
  177.                 i:=NothingAfter;
  178.             IF Length(SPtr)=0 THEN GOTO next;
  179.             IF SPtr[1] <> '~' THEN
  180.             BEGIN
  181.               IF FindFile(SPtr) THEN
  182.               BEGIN
  183.                 Seek(fp, LastStart);
  184.                 Ch:=#126;
  185.                 BlockWrite(fp, Ch, 1);
  186.                 Seek(fp, Current);
  187.               END ELSE
  188.               BEGIN
  189.                 SkippedOne:=True;
  190.                 Goto Next;
  191.               END;
  192.               IF i=TruncAfter THEN
  193.               BEGIN
  194.                 TruncateFile(SPtr);
  195.                 AddLog('#', 'Flagging ' + SPtr + ' as sent');
  196.               END ELSE
  197.                 IF i=ShowDeleteAfter THEN
  198.                 BEGIN
  199.                   DeleteFile(SPtr);
  200.                   AddLog('#', 'Unlinking ' + SPtr);
  201.                 END ELSE
  202.                   IF i=DeleteAfter THEN DeleteFile(SPtr);
  203.             END;
  204. next:
  205.           END;                      { While }
  206.           Close(fp);
  207.           IF Not SkippedOne THEN DeleteFile(FName);
  208.         END;                        { Not found }
  209.       END;                          { For }
  210.       Inc(AkaNum);
  211.       IF (AkaNum<=MaxAddresses) And (RemAka[AkaNum].Zone<>0) THEN
  212.       BEGIN
  213.         Call:=RemAka[AkaNum];
  214.       END ELSE
  215.         NoMoreAkas:=True;
  216.     UNTIL NoMoreAkas ;
  217.     Call:=OldAdr;
  218.   END;
  219.  
  220. BEGIN
  221.   FileNum:=0;
  222.   New(FileTab);
  223.   ASSIGN(bf, MaketaskFileName(PoPBiModemInterComLog)); FileMode:=ShareRead+ShareDenyW;
  224.   RESET(bf);
  225.   IF IOResult=0 THEN
  226.   BEGIN
  227.     WHILE NOT EOF(bf) DO
  228.     BEGIN
  229.       READ(bf,b);
  230.       FileName:=StUpCase(AsciiZ2Str(b.filepath,78));
  231.       IF (b.status<>'A') THEN
  232.       BEGIN
  233.         findfirst(filename,AnyFile,sr);
  234.         FindClose(Sr);
  235.         AddLog('+', 'CPS: '+Long2Str(b.cps DIV 10)+' ('+Long2Str(sr.size)+' bytes)  Efficiency '+
  236.                     Form('#,###.#',b.cps/ComPort^.GetBaudRate*100)+'%');
  237.         CASE b.direction OF
  238.           'R' : BEGIN
  239.                   Inc(FReceived);
  240.                   AddLog('+', 'Received-B '+FileName);
  241.                   s:=StUpCase(JustFileName(FileName));
  242.                   IsMail:=FALSE;
  243.                   IsReq:=FALSE;
  244.                   i:=POS('.',s);
  245.                   IF i>0 THEN
  246.                   BEGIN
  247.                     Ext:=COPY(s,i+1,3);
  248.                     IF LENGTH(s)=12 THEN
  249.                     BEGIN
  250.                       VAL('$'+COPY(s,1,8),l,i);
  251.                       IF i=0 THEN
  252.                       BEGIN
  253.                         IF (Ext='PKT') THEN IsMail:=TRUE ELSE
  254.                           IF (Ext='R'+HexB(Cfg.TaskNumber)) OR (Ext='PTF') THEN
  255.                             IsReq:=TRUE
  256.                           ELSE
  257.                             IF (Ext[3] IN ['0'..'9']) THEN
  258.                             BEGIN
  259.                               DEC(Ext[0]);
  260.                               IF (POS(Ext,'MO*TU*WE*TH*FR*SA*SU')>0) THEN IsMail:=TRUE;
  261.                             END;
  262.                       END ELSE
  263.                         IF (Ext='TIC') AND (Copy(s,1,2)='TK') THEN IsReq:=True;
  264.                     END;
  265.                   END;
  266.                   IF (NOT IsReq) AND IsMail THEN GotSomeMail:=TRUE ELSE
  267.                   BEGIN
  268.                     GotSomeFiles:=TRUE;
  269.                     IF NOT IsReq THEN
  270.                     BEGIN
  271.                       FILLCHAR(Ift,SizeOf(Ift),0);
  272.                       WITH Ift DO
  273.                       BEGIN
  274.                         FileName:=JustName(s);
  275.                         RecvTime:=CurrentTime;
  276.                         RecvDate:=Today;
  277.                         From:=RemHello.Address;
  278.                         TaskNum:=Cfg.TaskNumber;
  279.                       END;
  280.                       New(IftF, Open(True));
  281.                       IF IftF<>NIL THEN
  282.                       BEGIN
  283.                         IftF^.AddRec(Ift);
  284.                         Dispose(IftF, Close);
  285.                       END ELSE
  286.                         AddLog('!', 'Not enough memory to open: PORTAL.TIT');
  287.                     END;
  288.                   END;
  289.  
  290.                 END;
  291.           'S' : BEGIN
  292.                   INC(FSent);
  293.                   AddLog('+', 'Sent-B '+FileName);
  294.                   s:=StUpCase(AddBackSlash(Cfg.Outbound));
  295.                   s:=Copy(s,1,Length(s)-1);
  296.                   IF (s=COPY(filename,1,Length(s))) AND ((COPY(filename,Length(filename)-1,2)='UT')
  297.                                                      OR ((COPY(filename,Length(filename)-2,3)='RSP'))) THEN
  298.                   BEGIN
  299.                     IF DeleteFile(filename) THEN AddLog('#','Unlinking '+FileName);
  300.                   END ELSE AddToList(FileName);
  301.                 END;
  302.         END;
  303.       END;
  304.     END;
  305.     CLOSE(bf);
  306.     INC(StatRec^.DayStat[0].FilesIn, FReceived);
  307.     INC(StatRec^.DayStat[0].FilesOut, FSent);
  308.     DeleteFile(MaketaskFileName(PoPBiModemInterComLog));
  309.   END;
  310.   ExtFlags[3]:='F';
  311.   KillFloFile(ExtFlags);
  312.   DeleteFile(MakeTaskFileName('BIMODEM.PTH'));
  313.   Dispose(FileTab);
  314. END;
  315.  
  316. END.
  317.